home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / IPC / Mailslots / API / ServerMainFormUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-08-28  |  2.4 KB  |  100 lines
  1. unit ServerMainFormUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Timer1: TTimer;
  12.     Memo1: TMemo;
  13.     MainMenu1: TMainMenu;
  14.     LaunchChildApp1: TMenuItem;
  15.     procedure FormCreate(Sender: TObject);
  16.     procedure FormDestroy(Sender: TObject);
  17.     procedure LaunchChildApp1Click(Sender: TObject);
  18.     procedure Timer1Timer(Sender: TObject);
  19.   private
  20.     Mailslot: THandle;
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. const
  27.   MailslotNameFixedReadPrefix = '\\.\mailslot\';
  28.   MailslotName = 'SampleMailslot';
  29.   MailslotReadName = MailslotNameFixedReadPrefix + MailslotName;
  30.   MailslotMaxSize = 0; //any size
  31.   MailslotTimeout = 0; //don't wait
  32.  
  33. {$ifdef Ver90}
  34. type
  35.   //This exception class did not exist in Delphi 2
  36.   EWin32Error = class(Exception);
  37.  
  38. const
  39.   //Constant not defined in Delphi 2
  40.   Mailslot_No_Message = -1;
  41. {$endif}
  42.  
  43. implementation
  44.  
  45. {$R *.DFM}
  46.  
  47. procedure TForm1.FormCreate(Sender: TObject);
  48. begin
  49.   Mailslot := CreateMailslot(
  50.     MailslotReadName, MailslotMaxSize, MailslotTimeout, nil);
  51.   if Mailslot = Invalid_Handle_Value then
  52.     raise EWin32Error.Create('Unable to create mailslot');
  53. end;
  54.  
  55. procedure TForm1.FormDestroy(Sender: TObject);
  56. begin
  57.   CloseHandle(Mailslot);
  58. end;
  59.  
  60. procedure TForm1.LaunchChildApp1Click(Sender: TObject);
  61. const
  62.   ChildApp = 'ClientMailslot.Exe';
  63. var
  64.   SI: TStartupInfo;
  65.   PI: TProcessInformation;
  66. begin
  67.   GetStartupInfo(SI);
  68.   if not CreateProcess(nil, ChildApp, nil,
  69.            nil, False, 0, nil, nil, SI, PI) then
  70.     raise EWin32Error.Create('Unable to launch ' + ChildApp);
  71. end;
  72.  
  73. procedure TForm1.Timer1Timer(Sender: TObject);
  74. var
  75.   NextMsgSize, BytesRead: DWord;
  76.   Msg: String;
  77. begin
  78.   if not GetMailslotInfo(
  79.     Mailslot, nil, NextMsgSize, nil, nil) then
  80.   begin
  81.     Timer1.Enabled := False;
  82.     raise EWin32Error.Create('Cannot get mailslot information')
  83.   end;
  84.   //Check there is a message to read
  85.   if NextMsgSize <> Mailslot_No_Message then
  86.   begin
  87.     //Allocate string size as required and set length
  88.     SetLength(Msg, NextMsgSize);
  89.     //Read the data into the string variable
  90.     if not ReadFile(Mailslot, Msg[1], NextMsgSize, BytesRead, nil) then
  91.     begin
  92.       Timer1.Enabled := False;
  93.       raise EWin32Error.Create('Cannot read from mailslot');
  94.     end;
  95.     Memo1.Text := Msg
  96.   end
  97. end;
  98.  
  99. end.
  100.